home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 098 / rbbslist.bas < prev    next >
Encoding:
BASIC Source File  |  1985-06-03  |  4.6 KB  |  126 lines
  1. 10 ' RBBS-PC USERS DIRECTORY UPDATE PROGRAM
  2. 20 ' BY JOHN CERVENY 6/8/84, MODIFIED AND COMPILED BY LOREN D. JONES
  3. 30 '
  4. 40 DIM NAME.SORT$(2000)
  5. 50 DEFINT A-Z
  6. 60 '
  7. 70 ' PRINT THE TITLE PAGE ON THE SCREEN.
  8. 80 '
  9. 90 CLS
  10. 100 LOCATE  7,18:PRINT STRING$(45,42)
  11. 110 PRINT TAB(18);"*";TAB(62);"*"
  12. 120 PRINT TAB(18);"* RBBS - PC USERS DIRECTORY UPDATE PROGRAM  *"
  13. 130 PRINT TAB(18);"*                                           *"
  14. 140 PRINT TAB(18);"*             by John Cerveny               *"
  15. 150 PRINT TAB(18);"*                                           *"
  16. 160 PRINT TAB(18);"*   modified & compiled by Loren D. Jones   *"
  17. 170 PRINT TAB(18);"*";TAB(62);"*"
  18. 180 PRINT TAB(18);STRING$(45,42)
  19. 190 LOCATE 18,26,0:PRINT"PRESS SPACE BAR TO CONTINUE"
  20. 200 ' POKE 106,0
  21. 210 CMD$ = INKEY$
  22. 220 IF CMD$ = ""THEN GOTO 210
  23. 230 IF CMD$ = CHR$(27) THEN GOTO 1240
  24. 240 IF CMD$ = " " THEN GOTO 290
  25. 250 GOTO 200
  26. 260 '
  27. 270 ' ASK THE USER FOR THE SOURCE AND DESTINATION FILES.
  28. 280 '
  29. 290 CLS:PRINT:INPUT "What is the SOURCE file? (default file is USERS)";SOURCE$
  30. 300 PRINT: IF SOURCE$="" THEN SOURCE$="USERS"
  31. 310 INPUT "What is the DESTINATION file? (default file is BULLET4)";DESTIN$
  32. 320 PRINT: IF DESTIN$="" THEN DESTIN$="BULLET4"
  33. 330 PRINT:PRINT "ENTER  1  TO PROCEED WITH UPDATE OF USER FILE, "
  34. 340 PRINT "       2  TO CHANGE THE SOURCE AND DESTINATION FILES,"
  35. 350 INPUT "       3  TO ABORT THE PROGRAM.";CHOICE$
  36. 360 IF CHOICE$="" GOTO 400
  37. 370 IF ASC(CHOICE$)<49 OR ASC(CHOICE$)>51 THEN GOTO 400
  38. 380 IF CHOICE$="1"GOTO 410 ELSE IF CHOICE$="2"GOTO 290
  39. 390 IF CHOICE$="3" GOTO 1240
  40. 400 PRINT:PRINT"INVALID CHOICE.  PLEASE CHOOSE  1, 2, OR 3": GOTO 330
  41. 410 CLS: PRINT: PRINT "USER FILE UPDATE RUN STARTED AT ";TIME$ :BTIM$=TIME$:PRINT
  42. 420 '
  43. 430 ' CHECK TO SEE IF THE SOURCE FILE EXISTS.
  44. 440 '
  45. 450 ON ERROR GOTO 1230
  46. 460 OPEN SOURCE$ FOR INPUT AS #1 : CLOSE #1
  47. 470 '
  48. 480 ' THE SOURCE FILE (WHICH SHOULD BE IN SEQUENTIAL FORMAT) IS OPENED FOR
  49. 490 ' INPUT.  THE NAMES FROM THE SOURCE FILE ARE SWITCHED FROM THE FIRST
  50. 500 ' NAME - LAST NAME FORMAT TO ONE OF LAST NAME - FIRST NAME, AND A COMMA
  51. 510 ' IS INSERTED IN BETWEEN THE LAST AND FIRST NAMES.
  52. 520 '
  53. 530 OPEN "R",1,SOURCE$,128:END.USER=LOF(1)/128
  54. 540 FIELD 1,31 AS N$
  55. 550 COUNT = 1
  56. 560 IF COUNT > END.USER THEN GOTO 700
  57. 570 LOCATE 8,5:PRINT END.USER; "Records in file."
  58. 580 LOCATE 10,5:PRINT "Reading record: "; COUNT: GET 1,COUNT
  59. 590 IF LEFT$(N$,1)<"0" THEN 700
  60. 600 FSTBLKN = INSTR(N$," ")
  61. 610 SNDBLKN = INSTR(FSTBLKN + 1,N$," ") - 1
  62. 620 IF SNDBLKN < 1 THEN GOTO 680
  63. 630 USER.NAME$ = LEFT$(N$,SNDBLKN)
  64. 640 LAST.NAME = (SNDBLKN - FSTBLKN)
  65. 650 USER.NAME$ = RIGHT$(USER.NAME$,LAST.NAME) + ", " +LEFT$(USER.NAME$,FSTBLKN)
  66. 660 I = I + 1
  67. 670 NAME.SORT$(I) = USER.NAME$
  68. 680 COUNT = COUNT + 1: GOTO 560
  69. 690 CLOSE #1
  70. 700 '
  71. 710 ' THE USER NAME LISTING WILL NOW BE SORTED AND SENT TO THE DESTINATION FILE
  72. 720 ' THE NEW CONTENTS OF THE FILE WILL APPEAR ON THE SCREEN AS WELL.
  73. 730 '
  74. 740 OPEN DESTIN$ FOR OUTPUT AS #2
  75. 750 LOCATE 14,5:PRINT "Sorting....please stand by."
  76. 760 NROW% = COUNT
  77. 770 ' ======== Sort subroutine (Shell - Metzner sort) ========
  78. 780 JUMP% = NROW%
  79. 790 WHILE JUMP% <> 0
  80. 800   JUMP% = JUMP% \ 2
  81. 810     J2% = NROW% - JUMP%
  82. 820     J% = 1
  83. 830     WHILE J% <= J2%
  84. 840       I% = J%
  85. 850       WHILE I% > 0
  86. 860         J3% = I% + JUMP%
  87. 870         IF (NAME.SORT$(I%) <= NAME.SORT$(J3%)) THEN 910
  88. 880           SWAP NAME.SORT$(I%), NAME.SORT$(J3%)
  89. 890         I% = I% - JUMP%
  90. 900       WEND
  91. 910       J% = J% + 1:LOCATE 16,5:PRINT J%
  92. 920     WEND
  93. 930   WEND
  94. 940 PRINT:PRINT "THE FILE '";DESTIN$;"' WILL APPEAR AS FOLLOWS:":PRINT
  95. 950 S$ = STRING$(79,42)
  96. 960 PRINT #2, S$
  97. 970 PRINT S$
  98. 980 PRINT #2, "*";TAB(79);"*"
  99. 990 PRINT "*"; TAB(79);"*"
  100. 1000 PRINT #2,"*"; TAB(30);"-- USERS DIRECTORY --";TAB(79);"*"
  101. 1010 PRINT "*"; TAB(30);"-- USERS DIRECTORY --";TAB(79);"*"
  102. 1020 PRINT #2, "*"; TAB(79);"*"
  103. 1030 PRINT "*"; TAB(79); "*"
  104. 1040 COL = (I+1)/3
  105. 1050 X=1: Y=COL+1: Z=COL*2+1
  106. 1060 FOR C=1 TO COL
  107. 1070 PRINT #2, "*       ";NAME.SORT$(X); TAB(33); NAME.SORT$(Y); TAB(57);
  108. 1080 PRINT #2, NAME.SORT$(Z); TAB(79);"*"
  109. 1090 PRINT "*       ";NAME.SORT$(X); TAB(33); NAME.SORT$(Y); TAB(57);
  110. 1100 PRINT NAME.SORT$(Z); TAB(79);"*"
  111. 1110 X=X+1 : Y=Y+1 : Z=Z+1
  112. 1120 NEXT C
  113. 1130 PRINT #2, "*";TAB(79);"*"
  114. 1140 PRINT "*"; TAB(79); "*"
  115. 1150 PRINT #2, "*";TAB(79);"*"
  116. 1160 PRINT "*"; TAB(79); "*"
  117. 1170 PRINT #2, S$
  118. 1180 PRINT S$
  119. 1190 PRINT : PRINT "USER FILE UPDATE RUN ENDED AT ";TIME$: PRINT
  120. 1200 PRINT : PRINT "USER FILE UPDATE RUN BEGAN AT ";BTIM$: PRINT
  121. 1210 CLOSE #2
  122. 1220 GOTO 1240
  123. 1230 PRINT "SOURCE FILE COULD NOT BE FOUND."
  124. 1240 PRINT: PRINT "END OF PROGRAM"
  125. 1250 END
  126.